Segredos escondidos nos departamentos da UFCG

Nesta análise iremos brincar um um pouco com dados sobre as unidades acadêmicas da Universidade Federal de Campina Grande. Mais especificamente, utilizaremos os seguintes dados:

UORG: Unidade acadêmica em questão.
Outro: Representa a quantidade de funcionários da unidade acadêmica que não são professores.
idade_75perc: 75 percentil do tempo de serviço público dos servidores.
prof20: Representa a quantidade professores da unidade acadêmica em jornada de 20 horas.
prof40: Representa a quantidade professores da unidade acadêmica em jornada de 40 horas ou em dedicação exclusiva.

library('tidyverse')
library('plotly')
library('ggplot2')
library('broom')
library('GGally')

dados = read_csv(file = "dados.csv") 

dados_filtrados <- dados %>% 
  
  mutate(prof20 = `Professor 20h`,
         prof40 = `Professor 40h ou DE`,
         UORG = UORG_LOTACAO
         ) %>%
  select(-`Professor 20h`, 
         -`Professor 40h ou DE`, 
         -idade_25perc,
         -idade_mediana,
         -UORG_LOTACAO) %>%
  filter(complete.cases(dados))

Para ter uma noção melhor das relações entre as variáveis, utilizaremos um descritivo express que irá deixar claro se houver alguma correlação óbvia nos dados.

dados_filtrados %>% 
    select(-UORG) %>% 
    ggpairs(size = .5, 
            lower = list(continuous = wrap("points", size = .5, alpha = 0.3)))

Observando o descritivo express percebemos de cara que existe uma correlação média-forte entre as variáveis Outro e idade_75perc com valor de 0,606. Isso nos leva a entender que quantos mais funcionários não-professores, maior será o tempo de serviço público dos servidores (em geral) nessa unidade acadêmica. Será que isso é verdade? Vamos agrupar os dados e observar se vemos algum padrão.


Para embasar um pouco mais o agrupamento utilizei a estratégia de comparar:

1 - A distância entre o centro dos clusters e o centro dos dados.

2 - A distância entre cada ponto e o centro dos dados.

Com base na proporção dessas duas medidas é possível determinar um bom valor para o número de grupos, uma vez que quando a proporção entre as duas medidas para de aumentar não vale mais a pena aumentar o número de grupos.

how_many_groups = tibble(groups = 1:15) %>% 
    group_by(groups) %>% 
    do(
        kmeans(dados_filtrados %>% select(idade_75perc), 
               centers = .$groups, 
               nstart = 20) %>% glance()
    )

how_many_groups %>% 
    ggplot(aes(x = groups, y = betweenss / totss)) + 
    geom_line() + 
    geom_point()

Com base no gráfico acima decidi que 5 grupos seria uma boa quantidade para essa análise. E com a quantidade de grupos em mãos já é possível rodar o algoritmo kmeans e perceber o que os dados podem nos mostrar. Nessa análise resolvi utilizar apenas uma dimensão, o 75 percentil do tempo de serviço público dos servidores.

dados_filtrados_km <- dados_filtrados %>% select(idade_75perc) %>% kmeans(centers = 5, nstart = 20)

dados_filtrados_agrupado = dados_filtrados_km %>% augment(dados_filtrados)

Interpretando os grupos econtrados

Utilizando um gráfico de coordenadas paralelas fica ainda mais clara a nossa hipótese sobre a relação entre o número de servidores não-professores e a idade dos funcionários em geral, principalmente nos grupos 2 e 3. Vamos observar a média do número de servidores de cada grupo e a média do 75-percentil do tempo de serviço e ver se isso nos diz alguma coisa:

Grupo 1: 

mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 1))$Outro)
## [1] 5.142857
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 1))$idade_75perc)
## [1] 7.995248

Grupo 2: 

mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 2))$Outro)
## [1] 12.91667
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 2))$idade_75perc)
## [1] 33.9969

Grupo 3: 

mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 3))$Outro)
## [1] 6.727273
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 3))$idade_75perc)
## [1] 24.01827

Grupo 4: 

mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 4))$Outro)
## [1] 0.3333333
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 4))$idade_75perc)
## [1] 1.653288

Grupo 5: 

mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 5))$Outro)
## [1] 4.333333
mean((dados_filtrados_km %>% augment(dados_filtrados) %>% filter(.cluster == 5))$idade_75perc)
## [1] 13.42783

Observando as métricas de cada grupo conseguimos observar um padrão (não tão claro, até porque a correlação não é tão forte) em que um maior número de servidores realmente incide numa maior idade nas pessoas de uma certa unidade acadêmica. Isso fica ainda mais claro quando observamos o grupo 2 no qual a maior média de servidores não-professores corresponde a maior média dos 75-percentis de tempo de serviço.

Interessante ainda notar o grupo 4, onde o 75 percentil do tempo de serviço público é bastante baixo quando comparado aos outros grupos (assim como a quantidade de servidores/professores). Mais estranho ainda é que todos as 3 unidades acadêmicas nesse grupo possuem apenas 1 professor. Talvez por serem departamentos novos? Podemos verificar na visualização interativa mais abaixo.

dados_filtrados_km %>% 
    augment(dados_filtrados) %>% 
    gather(key = "variável", value = "valor", -UORG, -.cluster) %>% 
    ggplot(aes(x = `variável`, y = valor, group = UORG, colour = .cluster, colors="Set2")) + 
    geom_line(alpha = .2) + 
    facet_wrap(~ .cluster, scales ="free_x")

Observando os grupos encontrados 

plot_ly(
        dados_filtrados_agrupado, 
        x = ~Outro,
        y = ~idade_75perc,
        color = ~as.character(.cluster),
        type="scatter",
        mode="markers",
        colors = "Set1",
        text = ~paste("<b>",UORG, "</b><br>", "<b>Profs. 20 horas: </b>", prof20, "<br><b>Profs. 40 horas:</b> ", prof40,"<br><b>Servidores: </b>", Outro, "<br><b>75-percentil do tempo de serviço: </b>", format(round(idade_75perc, 2), nsmall=2)),
        hoverinfo = "text"
        )

Observando a variável idade_75perc mostrada nos dados do grupo 4 percebemos que temos servidores com mais de 2 anos de serviço nesses departamentos, ou seja essas unidades acadêmicas já não são tão novas assim. Então por que será que temos tão poucos funcionários/professores nelas? Será que está faltando recursos para fazer contratações? Fica aqui o questionamento…

Agora utilizando PCA

Encontrando os componentes com base nas variáveis originais:

dados_pca = dados_filtrados %>% column_to_rownames('UORG') %>% prcomp(scale=FALSE)

A relação entre os componentes encontrados e as variáveis originais

print(as.data.frame(dados_pca$rotation))
##                     PC1        PC2        PC3         PC4
## Outro        -0.2332847  0.2340374 -0.1775033  0.92698292
## idade_75perc -0.2794284  0.7501979 -0.4846147 -0.35252153
## prof20       -0.1162517 -0.5806125 -0.8049966 -0.03681216
## prof40       -0.9241123 -0.2128819  0.2926117 -0.12278478

Podemos ainda ver quanta variância é capturada por cada PC:

tidy(dados_pca, "pcs") %>% 
    ggplot(aes(x = PC, y = cumulative, label = cumulative)) + 
    geom_line() + 
    geom_point() + 
    geom_text(vjust = 1, hjust = -.1)

Agora vamos tentar achar a mesma estrutura de grupos que achamos usando K-means, mas dessa vez com as variáveis PC. Vejamos a visualização abaixo que mostra os grupos achados anteriormente agora de acordo com as variáveis PC:

au <- augment(dados_pca, dados_filtrados_agrupado)
    
 plot_ly(
          au,
          x = ~.fittedPC2,
          y = ~.fittedPC4,
          color = ~as.character(.cluster),
          type = "scatter",
          mode = "markers",
          colors = "Set1",
          text = ~paste("<b>",UORG, "</b><br>", "<b>Profs. 20 horas: </b>", prof20, "<br><b>Profs. 40 horas:</b> ", prof40,"<br><b>Servidores: </b>", Outro, "<br><b>75-percentil do tempo de serviço: </b>", format(round(idade_75perc, 2), nsmall=2)),
          hoverinfo = "text"
  )

Conclusão

Nesta breve análise, foi possível perceber a utilidade da ténica de PCA principalmente para agrupamentos. Muitas vezes reduzir a dimensão dos dados facilita a percepção de relações que de outra maneira estariam escondidas. Isso é possível apenas devido ao poder do PCA de comprimir informações multidimensionais e apresenta-las para nós na forma de uma visualização bidimensional, que facilita a percepção de padrões por nós humanos.

Comparando esta última visualização que utiliza PCA com a anterior podemos achar que houve uma certa bagunça nos dados, até porque alguns pontos que são de um mesmo grupo agora aparecem bem mais distantes. Porém, este é o poder do PCA, explicitar semelhanças e diferenças que de outra maneira não estariam visíveis. A Unidade Acadêmica de Medicina do grupo 3 por exemplo, está bem distante dos outros pontos do seu grupo pois possui um grande número de professores em regime de 20 horas comparado a outras unidades, algo que não estava perceptível na visualização anterior e foi explicitado utilizando PCA.